;;########################################################################
;; unimob1.lsp
;; code for univariate analysis model object (2 of 3)
;; file contains options  and save-data methods and supporting code
;; Copyright (c) 1995-8 by Forrest W. Young
;;########################################################################

;3 Vista System Methods

(defmeth univar-model-object-proto :options ()
"Message args: none
Presents dialog box to get univariate analysis options if :dialog t is used on the model constructor statement. Dialog values are checked for accuracy and error messages are produced if values are bad. Returns nil if :dialog nil, if dialog values are bad, or if dialog is canceled. Otherwise, returns five-element list of: 
1) list of the one or two selected variables (names + type); 
2) -1, 0 1 for negative 1-tail, 2 tail or postive 1-tail; 
3) mu; 
4) confidence interval level; and 
5) population variance (nil for T-test)."
  (let ((result nil))
    (when (send self :dialog)
        (let* ((row-pix 16)
               (nvar (length (send current-data :active-variables 
                                        '(numeric category))))
               (title (send text-item-proto :new "UNIVARIATE ANALYSIS"))
               (title2 (send text-item-proto :new 
                             "2: Provide details for T (or Z) test:"))
               (text1 (send text-item-proto :new (format nil
                      "Ho: Population Mean =~%(or mean difference)")))
               (mu    (send edit-text-item-proto :new "        0.00"))
               (text2 (send text-item-proto :new 
                            "H1: (alternative hypothesis)"))
               (direc (send choice-item-proto :new 
                            (list "Sample Mean LT Pop Mean (1 tail)"
                                  "Sample Mean NE Pop Mean (2 tails)"
                                  "Sample Mean GT Pop Mean (1 tail)")
                            :value 1))
               (text2a (send text-item-proto :new (format nil 
                       "Population Std. Dev. =~%(For Z-test, if known)")))
               (popvar (send edit-text-item-proto :new "              "))
               (text3 (send text-item-proto :new 
                      (format nil "Confidence Interval Level =~%")))
               (cilev (send edit-text-item-proto :new ".95"))
               (text4 (send text-item-proto :new 
                            "1: Select 1 or 2 variables:"))
               (num-vars (send current-data :active-variables '(numeric)))
               (cat-vars (send current-data :active-variables '(category)))
               (bin-vars (send self :binary-variables cat-vars))
               (num-L (length num-vars))
               (bin-L (length bin-vars))
               (var1 (send list-item-proto :new
                           (combine
                            (map-elements #'strcat num-vars
                                          (repeat " (Numeric)" num-L))
                            (map-elements #'strcat bin-vars
                                          (repeat " (Binary)" bin-L)))
                           :size (list 190 (* 6 row-pix))))
               (text5 (send text-item-proto :new 
                      (format nil "Selected Variable(s):")))
               (var2  (send list-item-proto :new (list " " " ")))
                          ;:size (list 190 (* 2 row-pix))
               (ok (send modal-button-proto :new "OK"
                         :action #'(lambda () 
                                     (list (send var2 :slot-value 'list-data)
                                           (- (send direc :value) 1)
                                           (read-from-string 
                                            (send mu    :text) nil)
                                           (read-from-string 
                                            (send cilev :text) nil)
                                           (read-from-string
                                            (send popvar :text) nil)
                                           ))))
               (cancel (send modal-button-proto :new "Cancel"))
               (dialog (send modal-dialog-proto :new
                             (list title 
                                  (list (list text4 var1
                                              text5 var2
                                              (list ok cancel))
                                        (list title2
                                              (list text1 mu) 
                                              text2 direc
                                              (list text2a popvar)
                                              (list text3 cilev))) )
                             :default-button ok))
               (var-list nil)
               (var1-name nil)
               (var1-type nil)
               (var1-values nil)
               (cat1 nil)
               (var2-name nil)
               (var2-type nil)
               (var2-values nil)
               (cat2 nil)
               (varbin-values nil)
               (error nil) 
               ) 
          (send var2 :slot-value 'list-data #())

          (defmeth dialog :switch-element 
            (me you your-max-L)
            (let* ((n (send me :selection))
                   (my-list   (send me  :slot-value 'list-data))
                   (your-list (send you :slot-value 'list-data))
                   (L-me  (length my-list))
                   (L-you (length your-list))
                   (my-string nil)
                   (L-selection nil)
                   (s nil))
              (send me :selection nil)
              (when (and n (> L-me 0))
                (when (< n L-me) 
                    (setf my-string (select my-list n))
                    (setf L-selection (length my-string))
                    (when (and (< n L-me) (< L-you your-max-L))
                          (setf s (select my-list n))
                          (when (< n (1- L-me))
                                (dolist (i (iseq n (- L-me 2)))
                                        (send me :set-text i 
                                              (select my-list (1+ i)))))
                          (send me :set-text (1- L-me) " ")
                          (send me :slot-value 'list-data
                                (select (send me :slot-value 'list-data) 
                                        (iseq (1- L-me))))
                          (send you :slot-value 'list-data
                                (concatenate 'vector your-list (vector s)))
                          (send you :set-text L-you s))))))

          (defmeth var1 :do-action (&optional dbl-clk)
            (send  dialog :switch-element var1 var2 2))
          (defmeth var2 :do-action (&optional dbl-clk)
            (send  dialog :switch-element var2 var1 nvar))

          (setf result (send dialog :modal-dialog))

          (when result
                (when (< (length (first result)) 1)
                      (error-message "You must select one or two variables.")
                      (setf error t))
                (when (not (numberp (third result)))
                      (error-message "The Population Mean must be a number.")
                      (setf error t))
                (when (or (not (numberp (fourth result)))
                          (>= (fourth result) 1) (<= (fourth result) 0))
                      (error-message "The Confidence Level must be a number between 0 and 1, but not including 0 or 1.")
                      (setf error t))
                (when (fifth result)
                      (when (or (not (numberp (fifth result)))
                                (< (fifth result) 0))
                            (error-message "If you specify a Population Standard Deviation, it must be a positive number.")
                            (setf error t)))
                (when error (setf result nil)))

          (when result
                (setf var-list  (first result))
                
                (setf var1-name (select var-list 0))
                (if (equal " (Numeric)" 
                           (subseq var1-name (- (length var1-name) 10) 
                                   (length var1-name)))
                    (setf var1-type "Numeric")
                    (setf var1-type "Binary"))
                (if (equal "Numeric" var1-type)
                    (setf var1-name (subseq var1-name 0 
                                            (- (length var1-name) 10)))
                    (setf var1-name (subseq var1-name 0 
                                            (- (length var1-name)  9))))
                (setf var1-values (combine
                      (send current-data :variable var1-name)))
     
                (when (= 2 (length var-list))
                      (setf var2-name (select var-list 1))
                      (if (equal " (Numeric)" 
                                 (subseq var2-name (- (length var2-name) 10) 
                                         (length var2-name)))
                          (setf var2-type "Numeric")
                          (setf var2-type "Binary"))
                      (if (equal "Numeric" var2-type)
                          (setf var2-name (subseq var2-name 0 
                                                  (- (length var2-name) 10)))
                          (setf var2-name (subseq var2-name 0 
                                                  (- (length var2-name)  9))))
                      (setf var2-values (combine
                            (send current-data :variable var2-name)))
                      )
                (when (and (equal var1-type "Binary") 
                           (equal var2-type "Binary"))
                      (error-message "At least one selected variable must be Numeric.")
                      (setf result nil))
                )
          (when result
                (send self :var1-type var1-type)
                (send self :var2-type var2-type)
                (send self :fixup-for-mv-data var1-type var2-type 
                      var1-values var2-values var1-name var2-name)
                (send self :direction (second result))
                (send self :mu (third result))
                (send self :ci-level (fourth result))
                (when (fifth result) (send self :sigma (fifth result))))
          ))
    (when (not (send self :dialog))
          (send self :fixup-for-mv-data
                (send self :var1-type)  (send self :var2-type) 
                (send self :var1)       (send self :var2)
                (send self :var1-label) (send self :var2-label))
          
          (setf result (list
                        (vector 
                         (strcat (send self :var1-label) " (Numeric)")
                         (strcat (send self :var2-label) " (Binary)"))
                        (send self :direction)
                        (send self :mu)
                        (send self :ci-level)
                        (send self :sigma))))
    (when result (send self :prepare-anova-variables))
    result))

(defmeth univar-model-object-proto :prepare-anova-variables 
  (  )
  (let* ((var1 (send self :var1))
         (var2 (send self :var2))
         (type1 (send self :var1-type))
         (type2 (send self :var2-type))
         (types (combine type1 type2))
         (lab1 (send self :var1-label))
         (lab2 (send self :var2-label))
         (L1 (length var1))
         (L2 (if var2 (length var2) nil))
         )
    (cond
      ((and (member "Binary" types :test #'equal)
            (member "Numeric" types :test #'equal))
       (send self :anova-response (combine var1 var2))
       (send self :anova-class (combine (repeat lab1 L1) (repeat lab2 L2))))
      ((and (equal type1 "Numeric") (equal type2 "Numeric"))
       (send self :anova-response (combine var1 var2))
       (send self :anova-class (combine (repeat lab1 L1) (repeat lab2 L2))))
      ))
  )

(defmeth univar-model-object-proto :fixup-for-mv-data 
  (var1-type var2-type var1-values var2-values var1-name var2-name)
  (let* ((varbin-values nil)
         (cat1 nil)
         (cat2 nil))
    (cond 
      ((or (equal var1-type "Binary") (equal var2-type "Binary"))
       (send self :n-ways 1)
       (cond ((equal var1-type "Binary")
              (send self :real-varnames (list var2-name var1-name))
              (setf varbin-values var1-values))
         (t (setf varbin-values var2-values)
            (send self :real-varnames (list var1-name var2-name))
            (setf var2-values var1-values)))
       
       (setf cat1 
             (select (remove-duplicates varbin-values 
                                        :test (quote equal)) 0))
       (setf cat2 
             (select (remove-duplicates varbin-values 
                                        :test (quote equal)) 1))
       
       (send self :var1
             (select var2-values (which 
                                  (map-elements #'equal cat1 varbin-values))))
       (send self :var2
             (select var2-values (which 
                                  (map-elements #'equal cat2 varbin-values))))
       (send self :var (list (send self :var1) (send self :var2)))
       (send self :var1-label cat1)
       (send self :var2-label cat2)
       )
      (t
       (send self :n-ways 0)
       (send self :var1 var1-values)
       (send self :var2 var2-values)
       (send self :var1-label var1-name)
       (cond 
         (var2-values
          (send self :real-varnames (list var1-name var2-name))
          (send self :var2-label var2-name)
          (send self :var (- (send self :var1) 
                             (send self :var2)))
          (send self :paired t))
         (t 
          (send self :real-varnames (list var1-name))
          (send self :var var1-values)))))
    ))

(defmeth univar-model-object-proto :binary-variables (cat-vars)
  (let* ((bin-vars cat-vars)
         (cat-L (length cat-vars))
         (var-name-now nil)
         (var-values-now nil))
    (dotimes (i cat-L)
     (setf var-name-now (select cat-vars i))
     (setf var-values-now (send current-data :variable var-name-now))
     (if (< 2 (length (remove-duplicates var-values-now :test 'equal)))
         (setf bin-vars (remove var-name-now bin-vars))))
    bin-vars))

(defmeth univar-model-object-proto :save-model-template (data-object)
"Args: (data-object)
DATA-OBJECT is the object-identification information of a data object. 
The method contains a template for saving the model-object." 
  (let* ((var1-label (send self :var1-label))
         (var2-label (send self :var2-label))
         )
    (cond
      ((= 1 (send self :n-ways))
       `(univariate-analysis    
         :title      ,(send self :title)
         :name       ,(send self :name) 
         :dialog      nil
         :variable   ,(first (send self :variables))
         :mu         ,(send self :mu)
         :sigma      ,(send self :sigma)
         :direction  ,(send self :direction)
         :ci-level   ,(send self :ci-level)
         :data (data ,(send data-object :name)
                     :title      ,(send data-object :title)
                     :variables ',(send self :variables)
                     :types     ',(send self :types)
                     :labels    ',(send self :labels)
                     :ways      ',(send data-object :ways)
                     :classes   ',(send data-object :classes)
                     :data      ',(send self :data))))
      ((not (send self :var2-label))
       `(univariate-analysis    
         :title      ,(send self :title)
         :name       ,(send self :name) 
         :dialog      nil
         :variable   ,var1-label
         :mu         ,(send self :mu)
         :sigma      ,(send self :sigma)
         :direction  ,(send self :direction)
         :ci-level   ,(send self :ci-level)
         :data (data ,(send data-object :name)
                     :title      ,(send data-object :title)
                     :variables ',(send self :variables)
                     :types     ',(send self :types)
                     :labels    ',(send self :labels)
                     :data      ',(send self :data))))
      ((send self :var2-label)
       `(univariate-analysis    
        :title      ,(send self :title)
        :name       ,(send self :name) 
        :dialog      nil
        :variable    (list ,var1-label ,var2-label)
        :mu         ,(send self :mu)
        :sigma      ,(send self :sigma)
        :direction  ,(send self :direction)
        :ci-level   ,(send self :ci-level)
        :data (data ,(send data-object :name)
                    :title      ,(send data-object :title)
                    :variables ',(send self :variables)
                    :types     ',(send self :types)
                    :labels    ',(send self :labels)
                    :data      ',(send self :data))))
      )
    ))

(defmeth univar-model-object-proto :create-data (&rest args)
  (error-message "Not available for Univariate Analysis."))

;(load (strcat *vista-dir-name* "unimob2"))